home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / sys.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  4.1 KB  |  232 lines  |  [TEXT/MPS ]
  1. /* Basic system calls */
  2.  
  3. #include <errno.h>
  4. #include <fcntl.h>
  5. #include <signal.h>
  6. #include "config.h"
  7. #ifdef __TURBOC__
  8. #include <io.h>
  9. #include <sys\stat.h>
  10. #endif
  11. #include "alloc.h"
  12. #include "fail.h"
  13. #include "globals.h"
  14. #include "instruct.h"
  15. #include "mlvalues.h"
  16. #include "signals.h"
  17. #include "stacks.h"
  18.  
  19. extern int errno;
  20.  
  21. #ifdef HAS_STRERROR
  22.  
  23. extern char * strerror();
  24.  
  25. char * error_message()
  26. {
  27.   return strerror(errno);
  28. }
  29.  
  30. #else
  31.  
  32. extern int sys_nerr;
  33. extern char * sys_errlist [];
  34.  
  35. char * error_message()
  36. {
  37.   if (errno < 0 || errno >= sys_nerr)
  38.     return "unknown error";
  39.   else
  40.     return sys_errlist[errno];
  41. }
  42.  
  43. #endif /* HAS_STRERROR */
  44.  
  45. void sys_error()
  46. {
  47.   raise_with_string(SYS_ERROR_EXN, error_message());
  48. }
  49.  
  50. void sys_exit(retcode)          /* ML */
  51.      value retcode;
  52. {
  53.   exit(Int_val(retcode));
  54. }
  55.  
  56. #ifndef O_BINARY
  57. #define O_BINARY 0
  58. #endif
  59. #ifndef O_TEXT
  60. #define O_TEXT 0
  61. #endif
  62.  
  63. static int sys_open_flags[] = {
  64.   O_RDONLY, O_WRONLY, O_RDWR, O_APPEND, O_CREAT, O_TRUNC, O_EXCL,
  65.   O_BINARY, O_TEXT
  66. };
  67. #ifdef macintosh
  68. static int sys_text_flags [] = { 0, 0, 0, 0, 0, 0, 0, 0, 1 };
  69. #endif
  70.  
  71. value sys_open(path, flags, perm) /* ML */
  72.      value path, flags, perm;
  73. {
  74.   int ret;
  75. #ifdef macintosh
  76.   extern void set_file_type (char *name, long type);
  77.   ret = open(String_val(path), convert_flag_list(flags, sys_open_flags));
  78.   if (ret != -1 && convert_flag_list (flags, sys_text_flags))
  79.     set_file_type (String_val (path), 'TEXT');
  80. #else
  81.   ret = open(String_val(path), convert_flag_list(flags, sys_open_flags),
  82.              Int_val(perm));
  83. #endif
  84.   if (ret == -1) sys_error();
  85.   return Val_long(ret);
  86. }
  87.  
  88. value sys_close(fd)             /* ML */
  89.      value fd;
  90. {
  91.   if (close(Int_val(fd)) != 0) sys_error();
  92.   return Atom(0);
  93. }
  94.  
  95. value sys_remove(name)          /* ML */
  96.      value name;
  97. {
  98.   int ret;
  99.   ret = unlink(String_val(name));
  100.   if (ret != 0) sys_error();
  101.   return Atom(0);
  102. }
  103.  
  104. value sys_rename(oldname, newname) /* ML */
  105.      value oldname, newname;
  106. {
  107. #ifdef HAS_RENAME
  108.   if (rename(String_val(oldname), String_val(newname)) != 0) sys_error();
  109. #else
  110.   invalid_argument("rename: not implemented");
  111. #endif
  112.   return Atom(0);
  113. }
  114.  
  115. value sys_chdir(dirname)        /* ML */
  116.      value dirname;
  117. {
  118.   if (chdir(String_val(dirname)) != 0) sys_error();
  119.   return Atom(0);
  120. }
  121.  
  122. extern char * getenv();
  123.  
  124. value sys_getenv(var)           /* ML */
  125.      value var;
  126. {
  127.   char * res;
  128.  
  129.   res = getenv(String_val(var));
  130.   if (res == 0) {
  131.     mlraise(Atom(NOT_FOUND_EXN));
  132.   }
  133.   return copy_string(res);
  134. }
  135.  
  136. static int sys_var_init[] = {
  137. #ifdef __TURBOC__
  138.   S_IREAD, S_IWRITE, S_IEXEC,
  139.   0, 0, 0,
  140.   0, 0, 0,
  141.   0, 0,
  142.   S_IREAD, S_IWRITE, S_IEXEC
  143. #else
  144.   0400, 0200, 0100,
  145.   0040, 0020, 0010,
  146.   0004, 0002, 0001,
  147.   04000, 02000,
  148.   0444, 0222, 0111
  149. #endif
  150. };
  151.  
  152. void sys_init(argv)
  153.      char ** argv;
  154. {
  155.   value v;
  156.   int i;
  157.  
  158.   v = copy_string_array(argv);
  159.   modify(&Field(global_data, SYS__COMMAND_LINE), v);
  160.   for (i = SYS__S_IRUSR; i <= SYS__S_IXALL; i++)
  161.     Field(global_data, i) = Val_long(sys_var_init[i - SYS__S_IRUSR]);
  162.   Field(global_data, SYS__INTERACTIVE) = Val_false;
  163. }
  164.  
  165. /* Handling of user interrupts */
  166.  
  167. #ifndef MSDOS
  168.  
  169. unsigned char raise_break_exn[] = { ATOM, BREAK_EXN, RAISE };
  170.  
  171. sighandler_return_type intr_handler(sig)
  172.      int sig;
  173. {
  174. #ifndef BSD_SIGNALS
  175.   signal (SIGINT, intr_handler);
  176. #endif
  177.   signal_handler = raise_break_exn;
  178.   signal_number = 0;
  179.   execute_signal();
  180. }
  181.  
  182. value sys_catch_break(onoff)    /* ML */
  183.      value onoff;
  184. {
  185.   if (Tag_val(onoff))
  186.     signal(SIGINT, intr_handler);
  187.   else
  188.     signal(SIGINT, SIG_DFL);
  189.   return Atom(0);
  190. }
  191.  
  192. #endif
  193.  
  194. /* Search path function */
  195.  
  196. #ifndef MSDOS
  197. #ifndef macintosh
  198.  
  199. char * searchpath(name)
  200.      char * name;
  201. {
  202.   static char fullname[512];
  203.   char * path;
  204.   char * p;
  205.   char * q;
  206.  
  207.   for (p = name; *p != 0; p++) {
  208.     if (*p == '/') return name;
  209.   }
  210.   path = getenv("PATH");
  211.   if (path == 0) return 0;
  212.   while(1) {
  213.     p = fullname;
  214.     while (*path != 0 && *path != ':') {
  215.       *p++ = *path++;
  216.     }
  217.     if (p != fullname) *p++ = '/';
  218.     q = name;
  219.     while (*q != 0) {
  220.       *p++ = *q++;
  221.     }
  222.     *p = 0;
  223.     if (access(fullname, 1) == 0) return fullname;
  224.     if (*path == 0) return 0;
  225.     path++;
  226.   }
  227. }
  228.  
  229. #endif
  230. #endif
  231.  
  232.